home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / x68000.arc / SOURCE.ARC / SYNTAXAN.MOD < prev    next >
Encoding:
Modula Implementation  |  1986-03-04  |  21.9 KB  |  712 lines
  1. IMPLEMENTATION MODULE SyntaxAnalyzer;
  2. (* Analyzes the operands to provide information for CodeGenerator *)
  3.  
  4.    FROM Strings IMPORT
  5.       Length;
  6.       
  7.    FROM LongNumbers IMPORT
  8.       LONG, LongAdd, LongSub, CardToLong, StringToLong, BinStrToLong;
  9.  
  10.    FROM SymbolTable IMPORT
  11.       SortSymTab, ReadSymTab;
  12.    
  13.    FROM ErrorX68 IMPORT
  14.       ErrorType, Error;
  15.  
  16.    FROM Parser IMPORT
  17.       OPERAND, SrcLoc;
  18.  
  19.    FROM CodeGenerator IMPORT
  20.       LZero, AddrCnt, Pass2;   (* BOOLEAN Switch *)
  21.  
  22.  
  23.    CONST
  24.       Zero = 30H;   (* The Ordinal value of the Character '0' *)
  25.       Seven = 37H;   (* The Ordinal value of the Character '7' *)
  26.       Quote = 47C;
  27.  
  28. (*---
  29.    TYPE
  30.       OpMode = (DReg,      (* Data Register *)
  31.                 ARDir,     (* Address Register Direct *)
  32.                 ARInd,     (* Address Register Indirect *)
  33.                 ARPost,    (* Address Register with Post-Increment *)
  34.                 ARPre,     (* Address Register with Pre-Decrement *)
  35.                 ARDisp,    (* Address Register with Displacement *)
  36.                 ARDisX,    (* Address Register with Disp. & Index *)
  37.                 AbsW,      (* Absolute Word (16-bit Address) *)
  38.                 AbsL,      (* Absolute Word (32-bit Address) *)
  39.                 PCDisp,    (* Program Counter Relative, with Displacement *)
  40.                 PCDisX,    (* Program Counter Relative, with Disp. & Index *)
  41.                 Imm,       (* Immediate *)
  42.                 MultiM,    (* Multiple Register Move *)
  43.                 SR,        (* Status Register *)
  44.                 CCR,       (* Condition Code Register *)
  45.                 USP,       (* User's Stack Pointer *)
  46.                 Null);     (* Error Condition, or Operand missing *)
  47.  
  48.       Xtype = (X0, Dreg, Areg);
  49.       SizeType = (S0, Byte, Word, S3, Long);
  50.  
  51.       OpConfig = RECORD                 (* OPERAND CONFIGURATION *)
  52.                     Mode : OpMode;
  53.                     Value : LONG;
  54.                     Loc : CARDINAL;     (* Location of Operand on line *)
  55.                     Rn : CARDINAL;      (* Register number *)
  56.                     Xn : CARDINAL;      (* Index Reg. nbr. *)
  57.                     Xsize : SizeType;   (* size of Index *)
  58.                     X : Xtype;          (* Is index Data or Address reg? *)
  59.                  END;
  60.                                                                         ---*)
  61.  
  62.    VAR
  63.       AbsSize : SizeType;    (* size of operand (Absolute only) *)
  64.  
  65.  
  66.    PROCEDURE StrToCard (s : ARRAY OF CHAR; VAR C : CARDINAL) : BOOLEAN;
  67.    (* Adapted form Hochstrasser Modula-2 System for Z80 CP/M *)
  68.  
  69.       CONST
  70.          maxCard = 65535;
  71.          maxNum = 6553;   (* cannot add another digit if C >= maxNum *)
  72.  
  73.       VAR
  74.          i, top : CARDINAL;
  75.          digit : INTEGER;
  76.          gotOne : BOOLEAN;
  77.  
  78.       BEGIN
  79.          i := 0;
  80.          C := 0;
  81.          top := HIGH (s);
  82.          gotOne := FALSE;
  83.  
  84.          LOOP
  85.             digit := ORD (s[i]) - Zero;
  86.             IF (digit >= 0) AND (digit <= 9) AND (i <= top) AND
  87.               ((C <= maxNum) OR (maxCard DIV C >= 10) AND
  88.                (maxCard - C * 10 >= CARDINAL (digit)))
  89.             THEN
  90.                gotOne := TRUE;
  91.                C := C * 10 + CARDINAL (digit);
  92.                INC (i);
  93.             ELSE
  94.                EXIT;
  95.             END;
  96.          END;
  97.  
  98.          RETURN ((s[i] = 0C) OR (i > top)) AND gotOne; 
  99.       END StrToCard;
  100.  
  101.  
  102.  
  103.    PROCEDURE CalcValue (Operand : OPERAND; VAR Value : LONG);
  104.    (* Calculates left and right values for GetValue *)
  105.  
  106.       VAR
  107.          Neg : BOOLEAN;
  108.          Dup : BOOLEAN;
  109.          Num : CARDINAL;
  110.          NumSyms : CARDINAL;
  111.  
  112.       BEGIN
  113.          IF Operand[0] = '-' THEN
  114.             Neg := TRUE;
  115.             Operand[0] := '0';
  116.          ELSE
  117.             Neg := FALSE;
  118.          END;
  119.  
  120.          IF StrToCard (Operand, Num) THEN   
  121.             (* It is a number *)
  122.             CardToLong (Num, Value);
  123.             IF Neg THEN
  124.                LongSub (LZero, Value, Value);
  125.             END;
  126.          ELSIF StringToLong (Operand, Value) THEN   
  127.             (* It is a HEX number *)
  128.          ELSIF BinStrToLong (Operand, Value) THEN
  129.             (* It is a Binary number *)
  130.          ELSIF (Operand[0] = Quote) AND (Operand[2] = Quote) THEN
  131.             CardToLong (ORD (Operand[1]), Value);
  132.          ELSIF (Length (Operand) = 1) AND (Operand[0] = '*') THEN
  133.             Value := AddrCnt;
  134.          ELSE   
  135.             (* It is a label, but may be undefined! *)
  136.             IF NOT Pass2 THEN
  137.                SortSymTab (NumSyms);
  138.             END;
  139.             IF NOT ReadSymTab (Operand, Value, Dup) THEN
  140.                Error (SrcLoc, Undef);
  141.             END;
  142.             IF Dup THEN
  143.                Error (SrcLoc, SymDup);
  144.             END;
  145.          END;
  146.       END CalcValue;
  147.  
  148.  
  149.  
  150.    PROCEDURE GetValue (Operand : OPERAND; VAR Value : LONG);
  151.    (* determines value of operand (in Decimal, HEX, or via Symbol Table) *)
  152.  
  153.       VAR
  154.          TempOp : OPERAND;
  155.          TempVal : LONG;
  156.          c, op : CHAR;
  157.          i, j : CARDINAL;
  158.          InQuotes : BOOLEAN;
  159.  
  160.       BEGIN
  161.          i := 0;   
  162.          Value := LZero;
  163.          InQuotes := FALSE;
  164.          op := '+';
  165.          REPEAT
  166.             j := 0;
  167.             LOOP
  168.                c := Operand[i];
  169.                TempOp[j] := c;
  170.                IF c = Quote THEN
  171.                   InQuotes := NOT InQuotes;
  172.                END;
  173.                INC (i);   INC (j);
  174.                IF c = 0C THEN
  175.                   EXIT;
  176.                END;
  177.                IF (c = '+') AND (NOT InQuotes) THEN
  178.                   EXIT;
  179.                END;
  180.                IF (c = '-') AND (i > 1) AND (NOT InQuotes) THEN
  181.                   EXIT;
  182.                END;
  183.             END;
  184.             TempOp[j - 1] := 0C;   (* in case c is +/- *)
  185.             CalcValue (TempOp, TempVal);
  186.             IF op = '-' THEN
  187.                LongSub (Value, TempVal, Value);
  188.             ELSE
  189.                LongAdd (Value, TempVal, Value);
  190.             END;
  191.             op := c;
  192.          UNTIL op = 0C;
  193.       END GetValue;
  194.  
  195.  
  196.  
  197.    PROCEDURE GetSize (VAR Symbol : ARRAY OF CHAR; VAR Size : SizeType);
  198.    (* determines size of opcode/operand: Byte, Word, Long *)
  199.  
  200.       VAR
  201.          i : CARDINAL;
  202.          c : CHAR;
  203.  
  204.       BEGIN
  205.          i := 0;
  206.          REPEAT
  207.             c := Symbol[i];
  208.             INC (i);
  209.          UNTIL (c = 0C) OR (c = '.');
  210.  
  211.          IF c = 0C THEN
  212.             Size := Word;   (* Default to size Word = 16 bits *)
  213.          ELSE
  214.             c := Symbol[i];   (* Record size extension *)
  215.             Symbol[i - 1] := 0C;   (* Chop size extension off *)
  216.             IF (c = 'B') OR (c = 'S') THEN   (* Byte or Short Branch/Jump *)
  217.                Size := Byte;
  218.             ELSIF c = 'L' THEN
  219.                Size := Long;
  220.             ELSE
  221.                Size := Word;   (* Default size *)
  222.             END;
  223.          END;
  224.       END GetSize;
  225.  
  226.  
  227.  
  228.    PROCEDURE GetAbsSize (VAR Symbol : ARRAY OF CHAR; VAR AbsSize : SizeType);
  229.    (* determines size of operand: Word or Long *)
  230.  
  231.       VAR
  232.          i : CARDINAL;
  233.          c : CHAR;
  234.          ParCnt : INTEGER;
  235.  
  236.       BEGIN
  237.          ParCnt := 0;
  238.          i := 0;
  239.          REPEAT
  240.             c := Symbol[i];
  241.             IF c = '(' THEN
  242.                INC (ParCnt);
  243.             END;
  244.             IF c = ')' THEN
  245.                DEC (ParCnt);
  246.             END;
  247.             INC (i);
  248.          UNTIL (c = 0C) OR ((c = '.') AND (ParCnt = 0));
  249.  
  250.          IF c = 0C THEN
  251.             AbsSize := Long;
  252.          ELSE
  253.             c := Symbol[i];   (* Record size extension *)
  254.             Symbol[i - 1] := 0C;   (* Chop size extension off *)
  255.             IF (c = 'W') OR (c = 'S') THEN
  256.                AbsSize := Word;
  257.             ELSE
  258.                AbsSize := Long;
  259.             END;
  260.          END;
  261.       END GetAbsSize;
  262.  
  263.  
  264.  
  265.    PROCEDURE GetInstModeSize (Mode : OpMode; Size : SizeType;
  266.                               VAR InstSize : CARDINAL) : CARDINAL;
  267.    (* Determines the size for the various instruction modes.    *)
  268.  
  269.       VAR
  270.          n : CARDINAL;
  271.  
  272.       BEGIN
  273.          CASE Mode OF
  274.             ARDisp,
  275.             ARDisX,
  276.             PCDisp,
  277.             PCDisX,
  278.             AbsW     :  n := 2;
  279.          |  AbsL     :  n := 4;
  280.          |  MultiM   :  IF Pass2 THEN
  281.                            n := 0;   (* accounted for by code generator *)
  282.                         ELSE
  283.                            n := 2;
  284.                         END;
  285.          |  Imm      :  IF Size = Long THEN
  286.                            n := 4;
  287.                         ELSE
  288.                            n := 2;
  289.                         END;
  290.          ELSE
  291.                         n := 0;
  292.          END;
  293.  
  294.          INC (InstSize, n);
  295.          RETURN (n * 2);
  296.       END GetInstModeSize;
  297.  
  298.  
  299.  
  300.    PROCEDURE GetOperand (Oper : OPERAND; VAR Op : OpConfig);  
  301.    (* Finds mode and value for source or destination operand *)
  302.  
  303.       VAR
  304.          ch : CHAR;
  305.          C : CARDINAL;   (* holds the ordinal value of a charcter *)
  306.          i, j : CARDINAL;
  307.          Len : CARDINAL;   (* Calculated Length of Oper *)
  308.          TempOp : OPERAND;
  309.          MultFlag : BOOLEAN;
  310.  
  311.       BEGIN
  312.          Op.Mode := Null;   Op.X := X0;
  313.          Len := Length (Oper);
  314.  
  315.          IF Len = 0 THEN
  316.             RETURN;   
  317.          END;
  318.  
  319.          GetAbsSize (Oper, AbsSize);
  320.  
  321.          IF Oper[0] = '#' THEN   (* Immediate *)
  322.             IF Pass2 THEN
  323.                i := 0;
  324.                REPEAT
  325.                   INC (i);
  326.                   Oper[i - 1] := Oper[i];
  327.                UNTIL Oper[i] = 0C;
  328.                GetValue (Oper, Op.Value);
  329.             END;
  330.             Op.Mode := Imm;
  331.             RETURN;
  332.          END;
  333.  
  334.          IF Len = 2 THEN   (* possible Addr or Data Register *)
  335.             C := ORD (Oper[1]);
  336.             IF (Oper[0] = 'S') AND (Oper[1] = 'R') THEN
  337.                (* Status Register *)
  338.                Op.Mode := SR;
  339.                RETURN;
  340.             ELSIF (Oper[0] = 'S') AND (Oper[1] = 'P') THEN
  341.                (* Stack Pointer *)
  342.                Op.Mode := ARDir;
  343.                Op.Rn := 7;
  344.                RETURN;
  345.             ELSIF (C >= Zero) AND (C <= Seven) THEN   
  346.                (* Looks Like an Addr or Data Reg *)
  347.                IF Oper[0] = 'A' THEN   (* Address Register *)
  348.                   Op.Mode := ARDir;
  349.                   Op.Rn := C - Zero;
  350.                   RETURN;
  351.                ELSIF Oper[0] = 'D' THEN   (* Data Register *)
  352.                   Op.Mode := DReg;
  353.                   Op.Rn := C - Zero;
  354.                   RETURN;
  355.                ELSE
  356.                   (* may be a label -- ignore for now *)
  357.                END;
  358.             ELSE
  359.                (* may be a label -- ignore for now *)
  360.             END;
  361.          END;
  362.  
  363.          IF Len = 3 THEN
  364.             IF (Oper[0] = 'C') AND (Oper[1] = 'C') AND (Oper[2] = 'R') THEN
  365.                (* Condition Code Register *)
  366.                Op.Mode := CCR;
  367.                RETURN;
  368.             ELSIF (Oper[0] = 'U') AND (Oper[1] = 'S') AND (Oper[2] = 'P') THEN
  369.                (* User's Stack Pointer *)
  370.                Op.Mode := USP;
  371.                RETURN;
  372.             ELSE
  373.                (* may be a label -- ignore for now *)
  374.             END;
  375.          END;
  376.  
  377.          IF (Len = 4) AND (Oper[0] = '(') AND (Oper[3] = ')') THEN
  378.             IF (Oper[1] = 'S') AND (Oper[2] = 'P') THEN
  379.                Op.Mode := ARInd;
  380.                Op.Rn := 7;
  381.                RETURN;
  382.             ELSIF Oper[1] = 'A' THEN
  383.                C := ORD (Oper[2]);
  384.                IF (C >= Zero) AND (C <= Seven) THEN
  385.                   Op.Mode := ARInd;
  386.                   Op.Rn := C - Zero;
  387.                   RETURN;
  388.                ELSE
  389.                   Error (Op.Loc, SizeErr);
  390.                   RETURN;
  391.                END;   
  392.             ELSE
  393.                Error (Op.Loc, AddrErr);
  394.                RETURN;
  395.             END;
  396.          END;
  397.           
  398.          IF (Len = 5) AND (Oper[0] = '(')
  399.           AND (Oper[3] = ')') AND (Oper[4] = '+') THEN
  400.            (* Address Indirect with Post Inc *)
  401.             IF (Oper[1] = 'S') AND (Oper[2] = 'P') THEN
  402.                (* System Stack Pointer *)
  403.                Op.Mode := ARPost;
  404.                Op.Rn := 7;
  405.                RETURN
  406.             ELSIF Oper[1] = 'A' THEN
  407.                C := ORD (Oper[2]);
  408.                IF (C >= Zero) AND (C <= Seven) THEN
  409.                   Op.Mode := ARPost;
  410.                   Op.Rn := C - Zero;
  411.                   RETURN;
  412.                ELSE
  413.                   Error (Op.Loc, SizeErr);
  414.                   RETURN;
  415.                END;   
  416.             ELSE
  417.                Error (Op.Loc, AddrErr);
  418.                RETURN;
  419.             END;
  420.          END;
  421.  
  422.          IF (Len = 5) AND (Oper[0] = '-') 
  423.           AND (Oper[1] = '(') AND (Oper[4] = ')') THEN
  424.             IF (Oper[2] = 'S') AND (Oper[3] = 'P') THEN
  425.                (* System Stack Pointer *)
  426.                Op.Mode := ARPre;
  427.                Op.Rn := 7;
  428.                RETURN;
  429.             ELSIF Oper[2] = 'A' THEN
  430.                C := ORD (Oper[3]);
  431.                IF (C >= Zero) AND (C <= Seven) THEN
  432.                   Op.Mode := ARPre;
  433.                   Op.Rn := C - Zero;
  434.                   RETURN;
  435.                ELSE
  436.                   Error (Op.Loc, SizeErr);
  437.                   RETURN;
  438.                END;
  439.             ELSE
  440.                Error (Op.Loc, AddrErr);
  441.                RETURN;
  442.             END;
  443.          END;
  444.  
  445.          (* Try to split off displacement (if present) *)
  446.          i := 0;
  447.          ch := Oper[i];
  448.          WHILE (ch # '(') AND (ch # 0C) DO   (* move to TempOp *)
  449.             TempOp[i] := ch;
  450.             INC (i);
  451.             ch := Oper[i];
  452.          END;
  453.          TempOp[i] := 0C;   (* Displacement (it it exists) now in TempOp *)
  454.  
  455.          IF (ch = '(') AND (TempOp[i - 1] # '+') THEN   
  456.             (* looks like a displacement mode *)
  457.             IF Pass2 THEN
  458.                GetValue (TempOp, Op.Value);   (* Value of Disp. *)
  459.             END;
  460.             j := 0;
  461.             REPEAT   (* put rest of operand (eg. (An,Xi) in TempOp *)
  462.                ch := Oper[i];
  463.                TempOp[j] := ch;
  464.                INC (i);   INC (j);
  465.             UNTIL ch = 0C;
  466.             IF Length (TempOp) > 4 THEN   (* Index may be present *)
  467.                i := 4;   (* Index starts at 4 *)
  468.                j := 0;
  469.                REPEAT                       (* put Xi in Oper *)
  470.                   ch := TempOp[i];
  471.                   Oper[j] := ch;
  472.                   INC (i);   INC (j);
  473.                UNTIL ch = 0C;
  474.  
  475.                IF Oper[j - 2] = ')' THEN
  476.                   Oper[j - 2] := 0C;
  477.                ELSE
  478.                   Error (Op.Loc, AddrErr);
  479.                   RETURN;
  480.                END;
  481.  
  482.                GetSize (Oper, Op.Xsize);
  483.                IF Op.Xsize = Byte THEN
  484.                   Error (Op.Loc, SizeErr);
  485.                   RETURN;
  486.                END;
  487.  
  488.                C := ORD (Oper[1]);
  489.                IF (Oper[0] = 'S') AND (Oper[1] = 'P') THEN
  490.                   (* Stack Pointer *)
  491.                   Op.X := Areg;
  492.                   Op.Xn := 7;
  493.                ELSIF Oper[0] = 'A' THEN
  494.                   IF (C >= Zero) AND (C <= Seven) THEN
  495.                      Op.X := Areg;
  496.                      Op.Xn := C - Zero;
  497.                   ELSE
  498.                      Error (Op.Loc, SizeErr);
  499.                      RETURN;
  500.                   END;
  501.                ELSIF Oper[0] = 'D' THEN
  502.                   IF (C >= Zero) AND (C <= Seven) THEN
  503.                      Op.X := Dreg;
  504.                      Op.Xn := C - Zero;
  505.                   ELSE
  506.                      Error (Op.Loc, SizeErr);
  507.                      RETURN;
  508.                   END;
  509.                ELSE
  510.                   Error (Op.Loc, AddrErr);
  511.                   RETURN;
  512.                END;
  513.  
  514.                IF (TempOp[1] = 'P') AND (TempOp[2] = 'C') THEN
  515.                   Op.Mode :=PCDisX;
  516.                   RETURN;    
  517.                ELSIF (TempOp[1] = 'S') AND (TempOp[2] = 'P') THEN
  518.                   (* Stack Pointer *)
  519.                   Op.Rn := 7;
  520.                   Op.Mode := ARDisX;
  521.                   RETURN;
  522.                ELSIF TempOp[1] = 'A' THEN
  523.                   C := ORD (TempOp[2]);
  524.                   IF (C >= Zero) AND (C <= Seven) THEN
  525.                      Op.Rn := C - Zero;
  526.                      Op.Mode := ARDisX;
  527.                      RETURN;
  528.                   ELSE
  529.                      Error (Op.Loc, SizeErr);
  530.                      RETURN;
  531.                   END;
  532.                ELSE
  533.                   Error (Op.Loc, AddrErr);
  534.                   RETURN;
  535.                END;
  536.             ELSE   (* No Index *)
  537.                IF (TempOp[1] = 'P') AND (TempOp[2] = 'C') THEN
  538.                   Op.Mode := PCDisp;
  539.                   RETURN;    
  540.                ELSIF (TempOp[1] = 'S') AND (TempOp[2] = 'P') THEN
  541.                   (* Stack Pointer *)
  542.                   Op.Mode := ARDisp;
  543.                   Op.Rn := 7;                                                
  544.                   RETURN;  
  545.                ELSIF TempOp[1] = 'A' THEN
  546.                   C := ORD (TempOp[2]);
  547.                   IF (C >= Zero) AND (C <= Seven) THEN
  548.                      Op.Rn := C - Zero;
  549.                      Op.Mode := ARDisp;
  550.                      RETURN;
  551.                   ELSE
  552.                      Error (Op.Loc, SizeErr);
  553.                      RETURN;
  554.                   END;
  555.                ELSE
  556.                   Error (Op.Loc, AddrErr);
  557.                   RETURN;
  558.                END;
  559.             END;
  560.          END;
  561.  
  562.          (* Check to see if this could be a register list for MOVEM: *)
  563.          i := 0;
  564.          MultFlag := FALSE;
  565.          LOOP
  566.             ch := Oper[i];   INC (i);
  567.             IF ch = 0C THEN
  568.                MultFlag := FALSE;
  569.                EXIT;
  570.             END;
  571.             IF (ch = 'A') OR (ch = 'D') THEN
  572.                ch := Oper[i];   INC (i);   C := ORD (ch);
  573.                IF ch = 0C THEN
  574.                   MultFlag := FALSE;
  575.                   EXIT;
  576.                END;
  577.                IF (C >= Zero) AND (C <= Seven) THEN
  578.                   ch := Oper[i];   INC (i);  
  579.                   IF ch = 0C THEN
  580.                      EXIT
  581.                   END;
  582.                   IF (ch = '/') OR (ch = '-') THEN
  583.                      MultFlag := TRUE;
  584.                   END;
  585.                ELSE
  586.                   MultFlag := FALSE;
  587.                   EXIT;
  588.                END;
  589.             ELSE
  590.                MultFlag := FALSE;
  591.                EXIT;
  592.             END;
  593.          END;
  594.          IF MultFlag THEN
  595.             Op.Mode := MultiM;
  596.             RETURN;
  597.          END;
  598.  
  599.          (* Must be absolute mode! *)
  600.          IF Pass2 THEN
  601.             GetValue (Oper, Op.Value);
  602.          END;
  603.          IF AbsSize = Word THEN
  604.             Op.Mode := AbsW;
  605.          ELSE
  606.             Op.Mode := AbsL;
  607.          END;
  608.       END GetOperand;
  609.  
  610.  
  611.  
  612.    PROCEDURE GetMultReg (Oper : OPERAND; PreDec : BOOLEAN;
  613.                          Loc : CARDINAL; VAR MultExt : BITSET);
  614.    (* Builds a BITSET marking each register used in a MOVEM instruction *)
  615.  
  616.       TYPE
  617.          MReg = (D0, D1, D2, D3, D4, D5, D6, D7, 
  618.                  A0, A1, A2, A3, A4, A5, A6, A7);
  619.  
  620.       VAR
  621.          i, j : CARDINAL;
  622.          ch : CHAR;
  623.          C : CARDINAL;   (* ORD value of ch *)
  624.          T1, T2 : MReg;   (* Temporary variables for registers *)
  625.          RegStack : ARRAY [0..15] OF MReg;   (* Holds specified registers *)
  626.          SP : CARDINAL;   (* Pointer for Register Stack *)
  627.          RegType : (D, A, Nil);
  628.          Range : BOOLEAN;
  629.          
  630.       BEGIN
  631.          SP := 0;
  632.          Range := FALSE;
  633.          RegType := Nil;
  634.          i := 0;
  635.  
  636.          ch := Oper[i];
  637.          WHILE ch # 0C DO
  638.             IF SP > 15 THEN
  639.                Error (Loc, SizeErr);
  640.                RETURN;
  641.             END;
  642.  
  643.             C := ORD (ch);
  644.             IF ch = 'A' THEN
  645.                IF RegType = Nil THEN
  646.                   RegType := A;
  647.                ELSE
  648.                   Error (Loc, OperErr);
  649.                   RETURN;
  650.                END;
  651.             ELSIF ch = 'D' THEN
  652.                IF RegType = Nil THEN
  653.                   RegType := D;
  654.                ELSE
  655.                   Error (Loc, OperErr);
  656.                   RETURN;
  657.                END;
  658.             ELSIF (C >= Zero) AND (C <= Seven) THEN
  659.                IF RegType # Nil THEN
  660.                   T2 := VAL (MReg, (ORD (RegType) * 8) + (C - Zero));
  661.                   IF Range THEN
  662.                      Range := FALSE;
  663.                      T1 := RegStack[SP - 1];   (* retreive 1st Reg in range *)
  664.                      FOR j := (ORD (T1) + 1) TO ORD (T2) DO
  665.                         RegStack[SP] := VAL (MReg, j);
  666.                         INC (SP);
  667.                      END;
  668.                   ELSE
  669.                      RegStack[SP] := T2;
  670.                      INC (SP);
  671.                   END;
  672.                ELSE
  673.                   Error (Loc, OperErr);
  674.                   RETURN;
  675.                END;
  676.             ELSIF ch = '-' THEN
  677.                IF (Range = FALSE) AND (RegType # Nil) AND (i > 0) THEN
  678.                   RegType := Nil;
  679.                   Range := TRUE;
  680.                ELSE
  681.                   Error (Loc, OperErr);
  682.                   RETURN;
  683.                END;
  684.             ELSIF ch = '/' THEN
  685.                IF (Range = FALSE) AND (RegType # Nil) AND (i > 0) THEN
  686.                   RegType := Nil;
  687.                ELSE
  688.                   Error (Loc, OperErr);
  689.                   RETURN;
  690.                END;
  691.             ELSE
  692.                Error (Loc, OperErr);
  693.                RETURN;
  694.             END;
  695.             
  696.             INC (i);
  697.             ch := Oper[i];
  698.          END;
  699.  
  700.          MultExt := {};
  701.          FOR j := 0 TO SP - 1 DO
  702.             C := ORD (RegStack[j]);
  703.             IF PreDec THEN
  704.                C := 15 - C;
  705.             END;
  706.             INCL (MultExt, C);
  707.          END;
  708.       END GetMultReg;
  709.  
  710. END SyntaxAnalyzer.
  711.  
  712.